''''''''''''''''''''''''''''''''''''''''''''''
' Enventory
'
' vbscript toolset to support administration, Enventory and control of AD Users and PC assets
'
' Copyright (C) ' by ufe@gmx.de
' started  July/August 2008, 
' based on work done within ::
'''''''''''''''''''''''''''''''''''
' Open Audit                      '
' http://open-audit.org	          '
' Software and Hardware Enventory '
' Outputs into MySQL              '
' (c) Mark Unwin 2003             '
'''''''''''''''''''''''''''''''''''
'
' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License along
' with this program; if not, write to the Free Software Foundation, Inc.,
' 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
'


' the colors

option explicit
REM RGB

dim myWhite 		: myWhite 			= "#FFFFFF"
dim myBlack			: myBlack 			= "#000000"
dim myVeryDarkGrey  : myVeryDarkGrey    = "#003300"  
dim myDarkerGrey 	: myDarkerGrey	 	= "#008000"  
dim myMediumGrey	: myMediumGrey	 	= "#339966"
dim myLightGrey		: myLightGrey	 	= "#E8ECDC"
dim myRed			: myred				= "#c73334"  


const XMLStyleTitle = "s24"
const XMLStyleHeader = "s23"
const XMLStyleHighlight = "s26"
const XMLStyleSpecial = "s25"
const XMLStyleNormal = "s21" ' odd is S21 and even is S22'
const XMLStyleNormalOdd = "s21" ' odd is S21 and even is S22'
const XMLStyleNormalEven = "s22" ' odd is S21 and even is S22'
 
'call testXLMFileCreation()

'DBTable2XML
Public Function DBTable2XML(XMLfileObj, strTableSubName, mySql)	
	if DDEEVV = True then on error goto 0 else on error resume next
	myDebug("DBTable2XML :: start " &  strTableSubName)
	If Not IsObject(DBConnection) Then DBOpen
	
	Dim rowStart, rowEnd, colStart,	colEnd, mycol , myrow
	
	Dim RS
	Dim RSArray
		
	myDebug("DBTable2XML " & mySql)
	if DDEEVV = true then  LogFileWrite ("DBTable2XML " & mySql)
	if DDEEVV = true then if DDEEVV = true then On Error Goto 0 else on error goto 0 
	'myDebug("vor query")
	Set RS = CreateObject("ADODB.Recordset")
	RS.Source = mySql
	RS.ActiveConnection =DBConnection
	RS.CursorType = 3        ' adOpenDynamic
	RS.LockType = 3        ' adLockOptimistic
	RS.Open
	'myDebug("nach query")    		
' 		Set RS = DBConnection.Execute (mySql)
' 		myDebug("nach query")
' 		If Err <> 0 Then
' 			myDebug(mySql & ":: something wrong with ->" & Err.Number & " -- " &  Err.Description)
' 			LogFileWrite (mySql & ":: something wrong with ->" & Err.Number & " -- " &  Err.Description)
' 			Err.Clear
' 		End If
'  		myDebug("vor auswertung")
' 		If DDEEVV = True Then  
' 			If Not IsObject(RS) Then
' 				myDebug("RS is no object")
' 			Else
' 				myDebug("RS(0) = " & RS(0))
' 			End If
' 		End If
' 
	If Not IsObject(RS) Then 
		DBTable2XML = 0
		myDebug("RS no object")
	Else
		If RS.recordcount = 0 Then
			DBTable2XML = 0
			myDebug("RS.Recordcount = 0")
		Else
			myDebug("DBTable2XML: Lets do it")
			dim XMLTableObj, XMLRow
			colend = rs.fields.count -1
			set XMLTableObj = XMLExcelFileAddWorksheet ( XMLfileObj, strTableSubName)
			set XMLRow = XMLExcelFILEAddRow ( XMLTableObj,XMLStyleTitle,1)
				XMLExcelFILEAddCell XMLRow, SuiteName & " - " & SuiteProg, "String"
				XMLExcelFILEAddCell XMLRow, strTableSubName, "String"
				XMLExcelFILEAddCell XMLRow, SignatureGet(), "String"
				
			set XMLRow = XMLExcelFILEAddRow ( XMLTableObj,XMLStyleHeader,1)
			for myCol = 0 to colend
					'myDebug  RS.Fields(mycol).Name
					XMLExcelFILEAddCell XMLRow, RS.Fields(mycol).Name,"String"
			next
			
			if DDEEVV = true then On Error Goto 0
			for myRow = 0 to RS.recordcount -1
				set XMLRow = XMLExcelFILEAddRow ( XMLTableObj,XMLStyleNormal,myRow)
				for myCol = 0 to colend
					'myDebug  RS.Fields(mycol).Value
					if isnull (RS.Fields(mycol).Value) then 
						XMLExcelFILEAddCell XMLRow, "","String"
					else
						XMLExcelFILEAddCell XMLRow, RS.Fields(mycol).Value ,"String"
					end if 
				next
				RS.MoveNext()
			next
		End If
	End If

	myDebug("DBTable2XML :: done " &  strTableSubName)
	if DDEEVV = true then  LogFileWrite ("DBTable2XML :: done " & strTableSubName)
	if DDEEVV = true then On Error Goto 0
End Function

'EnventoryExportDir 
'EnventoryExportDirLocal 
'WantExports 
'WantExportsLocal

public function XMLInit(name)
	myDebug("XMLInit " &  name)
	if DDEEVV = True then on error goto 0 else on error resume next
	set XMLInit = XMLExcelFileInit(DBGetTableName("") & "." & name)
end function

public function XMLWrite(myXMLFILE,name)
	myDebug("XMLWrite " & name)
	if DDEEVV = True then on error goto 0 else on error resume next
	myDebug("XMLWrite WantExports")
	if WantExports = true then 	XMLExcelFILEClose myXMLFILE, EnventoryExportDir  & "\" & SuiteName& "." & name & "." & DBGetTableName("")  & ".xml"
	myDebug("XMLWrite WantExportsLocal")
	if WantExportsLocal = true	then XMLExcelFILEClose myXMLFILE, EnventoryExportDirLocal  & "\" & SuiteName& "." & name & "." & DBGetTableName("") & ".xml"
	XMLWrite = EnventoryExportDir  & "\" & SuiteName& "." & name & "." & DBGetTableName("")  & ".xml"
	myDebug("XMLWrite " & XMLWrite)
	myDebug("XMLWrite leave" )
end function

private sub DelOldXML() 
	if DDEEVV = True then on error goto 0 else on error resume next
	dim fldname : fldname = EnventoryScriptsDir 
	dim fso
	dim fldr
	Dim dttoday
	set fso = createobject("scripting.filesystemobject")
	set fldr = fso.getfolder(fldname)
	dttoday = date
	'set dt2monthsago = dateadd("m", -2, dttoday)
	dtdiff = dateadd("d", -100, dttoday)
	recurseXML fldr 
end sub

sub recurseXML( byref fldr)
	if DDEEVV = True then on error goto 0 else on error resume next
	  dim subfolders,files,folder,file
	  set subfolders = fldr.subfolders
	  set files = fldr.files
	  'if DDEEVV = true then myDebug fldr.path
	  for each file in files
	    if file.datelastmodified < dtdiff then
	      logfilewrite( "Deleting " & file.name & " last modified: " & file.datelastmodified)
	      on error goto 0 
	      file.delete
	    end if
	  next  
	  for each folder in subfolders
			recurseXML folder
	  next  
	  set subfolders = nothing
	  set files = nothing
end sub

' better you have not more than 100 Tabs in your excelsheet
Dim XMLLastTableName(100)
Dim XMLLastTableObj(100)
Dim XMLLastRow(100)

Public Function XMLDoTableAr (StrTableSubName, StrDBTableVersion, ArTableData, ArTableWhere, XMLfileObj )
	if DDEEVV = True then on error goto 0 else on error resume next
	mydebug("XMLDoTableAr " & StrTableSubName )
	if not isobject (XMLfileObj) then mydebug("not isobject (XMLfileObj) " )
	if WantExports = false then exit function
	dim mytablename
	dim myXMLRow
	dim ThisTableNum
	
	if strtablesubname= "" then 
		mytablename = DBGetTableName("")
	else
		mytablename = strTableSubName
	end if
	dim col, row, colStart,colEnd,rowStart,rowEnd, myRowEnd
	rowStart = LBound(ArTableData, 1)
	rowEnd   = UBound(ArTableData, 1)
	for row = rowstart to rowend 
		if ArTableData(row,0) = "" then 
			myRowEnd = row
			exit for
		end if 
		'if DDEEVV = true then myDebug ArTableData(row,0)
	next 
	rowEnd = myRowEnd
	'myDebug("DBDoTableAr rowStart " & rowStart & " rowEnd " & rowEnd)
	
	for ThisTableNum = 0 to Ubound (XMLLastTableName)
		if XMLLastTableName(ThisTableNum) = mytablename then 
				'if DDEEVV = true then myDebug(mytablename & " again " & XMLLastRow(ThisTableNum))
				'if DDEEVV = true then LogFileWrite (mytablename & " again " & XMLLastRow(ThisTableNum))
				XMLLastRow(ThisTableNum) = XMLLastRow(ThisTableNum) + 1
				exit for
		end if 
		if XMLLastTableName(ThisTableNum) = "" then
			XMLLastTableName(ThisTableNum) = mytablename
			XMLLastRow(ThisTableNum) = 0
			'if DDEEVV = true then myDebug(mytablename & " new " & XMLLastRow(ThisTableNum))
			'myDebug("XMLDoTableAr" & mytablename & " new " & XMLLastRow(ThisTableNum))
			'set XMLLastTableObj(ThisTableNum) = XMLExcelFileAddWorksheet (XMLfileObj, mytablename)
			dim bla
			set bla = XMLExcelFileAddWorksheet (XMLfileObj, mytablename)
			set XMLLastTableObj(ThisTableNum) = bla
			set myXMLRow = XMLExcelFILEAddRow ( XMLLastTableObj(ThisTableNum),XMLStyleTitle,1)
			XMLExcelFILEAddCell myXMLRow,SuiteName & "::" & SuiteProg, "String"
			XMLExcelFILEAddCell myXMLRow,mytablename,"String"
			XMLExcelFILEAddCell myXMLRow,"Vers. "&  StrDBTableVersion,"String"
			XMLExcelFILEAddCell myXMLRow, DBmyEntryDateStr & " " & DBmyTimeStr & " " & DBmyTZStr,"String"
			set myXMLRow = XMLExcelFILEAddRow ( XMLLastTableObj(ThisTableNum),XMLStyleHeader,1)
			dim ColumnTitel
			For row=rowStart To rowEnd -1
			
				if ArTableData(row,2) <> "*" then
			
					ColumnTitel = Replace(ArTableData(row,0),"[","")
					ColumnTitel = Replace(ColumnTitel,"]","")
					XMLExcelFILEAddCell myXMLRow, ColumnTitel,"String"
				end if
			
			Next
			
			exit for
			
		end if
	
	next
	
	set myXMLRow = XMLExcelFILEAddRow ( XMLLastTableObj(ThisTableNum),XMLStyleNormal,XMLLastRow(ThisTableNum))
	For row=rowStart To rowEnd -1
		if ArTableData(row,2) <> "*" then
			XMLExcelFILEAddCell myXMLRow, ArTableData(row,2) ,"String"
		end if
	Next
	
end function

public sub testXLMFileCreation()
	if DDEEVV = True then on error goto 0 else on error resume next

    dim filename
    filename= right(WScript.ScriptFullName, len(WScript.ScriptFullName)- InStrRev(WScript.ScriptFullName, "\"))
    
    dim myXMLFile, myXMLWorksheet0, myXMLWorksheet1, myXMLExcelRow0, myXMLExcelRow1
    set myXMLFileObj = XMLExcelFileInit(filename)
    set myXMLWorksheet0 = XMLExcelFileAddWorksheet (myXMLFile, "Sheeeet0")
    set myXMLWorksheet1 = XMLExcelFileAddWorksheet (myXMLFile, "Sheeeet1")
	
    set myXMLExcelRow0 = XMLExcelFILEAddRow ( myXMLWorksheet0,XMLStyleTitle,1)
    set myXMLExcelRow1 = XMLExcelFILEAddRow ( myXMLWorksheet1,XMLStyleTitle,1)
    
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleTitle0 " & XMLStyleTitle,"String"
	XMLExcelFILEAddCell myXMLExcelRow1,"XMLStyleTitle1 " & XMLStyleTitle,"String"
	
	set myXMLExcelRow0 = XMLExcelFILEAddRow ( myXMLWorksheet0,XMLStyleHeader,1)
    set myXMLExcelRow1 = XMLExcelFILEAddRow ( myXMLWorksheet1,XMLStyleHeader,1)
    
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleHeader0 " & XMLStyleHeader,"String"
	XMLExcelFILEAddCell myXMLExcelRow1,"XMLStyleHeader1 " & XMLStyleHeader,"String"
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleHeader01 " & XMLStyleHeader,"String"
	XMLExcelFILEAddCell myXMLExcelRow1,"XMLStyleHeader11 " & XMLStyleHeader,"String"
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleHeader02 " & XMLStyleHeader,"String"
	XMLExcelFILEAddCell myXMLExcelRow1,"XMLStyleHeader12 " & XMLStyleHeader,"String"
	
	dim myrow, mycol
	
	for myrow = 0 to 8
		set myXMLExcelRow0 = XMLExcelFILEAddRow ( myXMLWorksheet0,XMLStyleNormal,myrow)
		set myXMLExcelRow1 = XMLExcelFILEAddRow ( myXMLWorksheet1,XMLStyleNormal,myrow)
		for mycol = 0 to 10
			XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleNormaldata1 " & XMLStyleNormal & myrow & mycol,"String"
			XMLExcelFILEAddCell myXMLExcelRow1,"XMLStyleNormaldata2 " & XMLStyleNormal & myrow & mycol,"String"
		next
	next
	
	set myXMLExcelRow0 = XMLExcelFILEAddRow ( myXMLWorksheet0,XMLStyleNormal,1)
    set myXMLExcelRow1 = XMLExcelFILEAddRow ( myXMLWorksheet1,XMLStyleNormal,1)
	set myXMLExcelRow0 = XMLExcelFILEAddRow ( myXMLWorksheet0,XMLStyleHighlight,1)
    set myXMLExcelRow1 = XMLExcelFILEAddRow ( myXMLWorksheet1,XMLStyleHighlight,1)
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleHighlightHigh0 " & XMLStyleHighlight,"String"
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleHighlightHigh1 " & XMLStyleHighlight,"String"
		 
	set myXMLExcelRow0 = XMLExcelFILEAddRow ( myXMLWorksheet0,XMLStyleNormal,1)
    set myXMLExcelRow1 = XMLExcelFILEAddRow ( myXMLWorksheet1,XMLStyleNormal,1)
	set myXMLExcelRow0 = XMLExcelFILEAddRow ( myXMLWorksheet0,XMLStyleSpecial,1)
    set myXMLExcelRow1 = XMLExcelFILEAddRow ( myXMLWorksheet1,XMLStyleSpecial,1)
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleSpecial special0 " & XMLStyleSpecial,"String"
	XMLExcelFILEAddCell myXMLExcelRow0,"XMLStyleSpecial special1 " & XMLStyleSpecial,"String"
	
	XMLExcelFILEClose myXMLFILE, filename & ".xml"
  
end sub

public function XMLExcelFileInit(name)
	if DDEEVV = True then on error goto 0 else on error resume next
	' create object
	Dim XMLDoc, myroot
	Set XMLDoc = CreateObject("Msxml2.DOMDocument")
	
	' <?xml version="1.0"?>
	XMLDoc.insertBefore   XMLDoc.createProcessingInstruction( "xml", "version = ""1.0""" ) ,XMLDoc.DocumentElement 
	set myroot = XMLDoc.documentElement 
	
	Dim DBmyTimeStr, DBmyEntryDateStr,  DBmyEntryDate
	DBmyEntryDateStr = Year(date) & "-" & Right("00" & Left(Int(Month(date)), 2), 2) & "-" & Right("00" & Left(Int(Day(date)), 2), 2)
	DBmyTimeStr = FormatDateTime(time, 4)
 		
	XMLDoc.AppendChild XMLDoc.CreateComment( WScript.ScriptFullName & " " & DBmyEntryDateStr & " " & DBmyTimeStr &  " " & myTimeZone () & " " & UserNameGet() & "@" & ComputerNameGet() ) 
	' <?mso-application progid="Excel.Sheet"?>
	XMLDoc.insertBefore  XMLDoc.createProcessingInstruction("mso-application", "progid=""Excel.Sheet""" ) ,XMLDoc.DocumentElement

	' <Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
	Dim Workbook
	Set Workbook = XMLDoc.CreateElement("Workbook")
	XMLDoc.AppendChild(Workbook)
	Workbook.SetAttribute "xmlns","urn:schemas-microsoft-com:office:spreadsheet"
	 ' xmlns:o="urn:schemas-microsoft-com:office:office"
	Workbook.SetAttribute "xmlns:o", "urn:schemas-microsoft-com:office:office"
	 ' xmlns:x="urn:schemas-microsoft-com:office:excel"
	Workbook.SetAttribute "xmlns:x", "urn:schemas-microsoft-com:office:excel"
	 ' xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet"
	Workbook.SetAttribute "xmlns:ss","urn:schemas-microsoft-com:office:spreadsheet"
	 ' xmlns:html="http://www.w3.org/TR/REC-html40">
	Workbook.SetAttribute "xmlns:html", "http://www.w3.org/TR/REC-html40"

	' <DocumentProperties xmlns="urn:schemas-microsoft-com:office:office">
	Dim DocumentProperties
	Set DocumentProperties = XMLDoc.CreateElement("DocumentProperties")
	Workbook.AppendChild(DocumentProperties)
	DocumentProperties.SetAttribute "xmlns", "urn:schemas-microsoft-com:office:office"
	'DocumentProperties.appendChild(xmlDoc.createTextNode(vbCrLf & "2"))
	    ' <Title>titel</Title>
		Dim Title
	    Set Title = XMLDoc.CreateElement("Title")
	    Title.Text = SuiteName &"."& SuiteProg
	    DocumentProperties.AppendChild (title)
	    ' <Subject>thema</Subject>
		Dim Subject
	    Set Subject = XMLDoc.CreateElement("Subject")
	    Subject.Text = Name
	    DocumentProperties.AppendChild (Subject)
	    ' <Author>autor</Author>
		Dim Author
	    Set Author = XMLDoc.CreateElement("Author")
	    Author.Text =  WScript.ScriptFullName
	    DocumentProperties.AppendChild (Author)
	    ' <Keywords>stichwörter</Keywords>
		Dim Keywords
	    Set Keywords = XMLDoc.CreateElement("Keywords")
	    Keywords.Text = SuiteName & "." & SuiteProg 
	    DocumentProperties.AppendChild (Keywords)
	    ' <Description>kommentar</Description>
		Dim Description
	    Set Description= XMLDoc.CreateElement("Description")
	    Description.Text = SuiteName & " - " & SuiteProg & vbcrlf & copyrightget()
	    DocumentProperties.AppendChild (Description)
	    ' <Created>2009-01-14T08:10:36Z</Created>
		Dim Created
	    Set Created = XMLDoc.CreateElement("Created")
	    Created.Text = DBmyEntryDateStr & "T" & DBmyTimeStr & "Z"
	    DocumentProperties.AppendChild (Created)
	    ' <Manager>manager</Manager>
		Dim Manager
	    Set Manager = XMLDoc.CreateElement("Manager")
	    Manager.Text = UserNameGet()
	    DocumentProperties.AppendChild (Manager)
	    ' <Company>myDom im de gmbh</Company>
		Dim Company
	    Set Company = XMLDoc.CreateElement("Company")
	    Company.Text = ComputerNameGet()
	    DocumentProperties.AppendChild (Company)
	    ' <Version>11.9999</Version>
		Dim Version
	    Set Version = XMLDoc.CreateElement("Version")
	    Version.Text = 	CRC32( WScript.ScriptFullName & " " & DBmyEntryDateStr & " " & DBmyTimeStr &  " " & myTimeZone () & " " & UserNameGet() & "@" & ComputerNameGet()) 
	    DocumentProperties.AppendChild (Version) ' </DocumentProperties>

	' <OfficeDocumentSettings xmlns="urn:schemas-microsoft-com:office:office">
	Dim OfficeDocumentSettings
	Set OfficeDocumentSettings = XMLDoc.CreateElement("OfficeDocumentSettings")
	    Workbook.AppendChild(OfficeDocumentSettings)
	    OfficeDocumentSettings.SetAttribute "xmlns", "urn:schemas-microsoft-com:office:office"
	    ' <Colors>
		Dim Colors, Color
	    Set Colors = XMLDoc.CreateElement("Colors")
	    OfficeDocumentSettings.AppendChild (Colors)
	        ' <Color>
			Set Color = XMLDoc.CreateElement("Color")
				Colors.AppendChild (Color)
				Dim Index
	            Set Index = XMLDoc.CreateElement("Index")
	            Index.Text = "12"
	            Color.AppendChild (Index)
	           	Dim myRGB
	            Set myRGB = XMLDoc.CreateElement("RGB")
	            myRGB.Text = myred
	            Color.AppendChild (myRGB)
	        ' </Color>
	        Set Color = XMLDoc.CreateElement("Color")
	        Colors.AppendChild (Color)
	            Set Index = XMLDoc.CreateElement("Index")
	            Index.Text = "48"
	            Color.AppendChild (Index)
	            Set myRGB = XMLDoc.CreateElement("RGB")
	            myRGB.Text = myVeryDarkGrey
	            Color.AppendChild (myRGB)
	        ' </Color>
	        ' <Color>
	            Set Color = XMLDoc.CreateElement("Color")
	            Colors.AppendChild (Color)
	            Set Index = XMLDoc.CreateElement("Index")
	            Index.Text = "13"
	            Color.AppendChild (Index)
	            Set myRGB = XMLDoc.CreateElement("RGB")
	            myRGB.Text = myDarkerGrey
	            Color.AppendChild (myRGB)
	        ' </Color>
	        ' <Color>
	            Set Color = XMLDoc.CreateElement("Color")
	            Colors.AppendChild (Color)
	            ' <Index>35</Index>
	            Set Index = XMLDoc.CreateElement("Index")
	            Index.Text = "7"
	            Color.AppendChild (Index)
	            ' <RGB>#B8BDDC</RGB>
	            Set myRGB = XMLDoc.CreateElement("RGB")
	            myRGB.Text = myLightGrey	
	            Color.AppendChild (myRGB)
	        ' </Color>
	        ' <Color>
	            Set Color = XMLDoc.CreateElement("Color")
	            Colors.AppendChild (Color)
	            ' <Index>37</Index>
	            Set Index = XMLDoc.CreateElement("Index")
	            Index.Text = "33"
	            Color.AppendChild (Index)
	            ' <RGB>#224992</RGB>
	            Set myRGB = XMLDoc.CreateElement("RGB")
	            myRGB.Text = myLightGrey	 
	            Color.AppendChild (myRGB)
	        ' </Color>
	        ' <Color>
	            Set Color = XMLDoc.CreateElement("Color")
	            Colors.AppendChild (Color)
	            ' <Index>39</Index>
	            Set Index = XMLDoc.CreateElement("Index")
	            Index.Text = "41"
	            Color.AppendChild (Index)
	            ' <RGB>#>#8B93C4</RGB>
	            Set myRGB = XMLDoc.CreateElement("RGB")
	            myRGB.Text = myLightGrey
	            Color.AppendChild (myRGB)
	            ' </Color>
	    ' </Colors>
	' </OfficeDocumentSettings>

	' <Styles>
		Dim Styles
		Set Styles = XMLDoc.CreateElement("Styles")
		Workbook.AppendChild(Styles)
	    '<Style ss:ID="Default" ss:Name="Normal">
		Dim Style
	    Set Style  = XMLDoc.CreateElement("Style")
	    Styles.AppendChild (Style)
	    Style.SetAttribute "ss:ID", "Default"
	    Style.SetAttribute "ss:Name", "Normal"
	   ' <Alignment ss:Vertical="Bottom"/>
		Dim Alignment
	    Set Alignment  = XMLDoc.CreateElement("Alignment")
	    Style.AppendChild (Alignment)
	    Alignment.SetAttribute "ss:Vertical", "Bottom"
	   ' <Borders/>
		Dim Borders
	    Set Borders  = XMLDoc.CreateElement("Borders")
	    Style.AppendChild (Borders)
	   ' <Font/>
		Dim Font
	    Set Font = XMLDoc.CreateElement("Font")
	    Style.AppendChild (Font)
		Font.SetAttribute "ss:FontName", "Tahoma"
	   ' <Interior/>
		Dim Interior
	    Set Interior  = XMLDoc.CreateElement("Interior")
	    Style.AppendChild (Interior)
	   ' <NumberFormat/>
		Dim NumberFormat
	    Set NumberFormat  = XMLDoc.CreateElement("NumberFormat")
	    Style.AppendChild (NumberFormat)
	   ' <Protection/>
		Dim Protection
	    Set Protection  = XMLDoc.CreateElement("Protection")
	    Style.AppendChild (Protection)
	  ' </Style>
	  '
	 '    <Styles>
	  '    <Style ss:ID="s21">
	    Set Style= XMLDoc.CreateElement("Style")
	    Styles.AppendChild (Style)
	    Style.SetAttribute "ss:ID", "s21"
		dim Border
		'Set Borders= XMLDoc.CreateElement("Borders")
		'Style.AppendChild (Borders)
		'<Borders>
			'<Border ss:Position="Left" ss:LineStyle="Continuous" ss:Weight="2"	ss:Color="#FFFFFF"/>
			'Set Border= XMLDoc.CreateElement("Border")
			'Borders.AppendChild (Border)
			'border.SetAttribute "ss:Position", "Left" 
			'border.SetAttribute "ss:LineStyle", "Continuous" 
			'border.SetAttribute "ss:Weight", "2" 
			'border.SetAttribute "ss:Color", myWhite 
			'<Border ss:Position="Right" ss:LineStyle="Continuous" ss:Weight="2"	ss:Color="#FFFFFF"/>
			'Set Border= XMLDoc.CreateElement("Border")
			'Borders.AppendChild (Border)
			'border.SetAttribute "ss:Position", "Right" 
			'border.SetAttribute "ss:LineStyle", "Continuous" 
			'border.SetAttribute "ss:Weight", "2" 
			'border.SetAttribute "ss:Color", myWhite 
		'</Borders>
	   '    <Font x:Family="Swiss" ss:Color=myDarkerGrey/>
	    Set Font = XMLDoc.CreateElement("Font")
	    Style.AppendChild (Font)
		Font.SetAttribute "ss:FontName", "Tahoma"
	    Font.SetAttribute "ss:Color", myDarkerGrey
	    Font.SetAttribute "x:Family", "Swiss"
	  '    </Style>
	  '    <Style ss:ID="s22">
	    Set Style= XMLDoc.CreateElement("Style")
	    Styles.AppendChild (Style)
	    Style.SetAttribute "ss:ID", "s22"
		Set Borders= XMLDoc.CreateElement("Borders")
		Style.AppendChild (Borders)
		'<Borders>
			'<Border ss:Position="Left" ss:LineStyle="Continuous" ss:Weight="2"	ss:Color="#FFFFFF"/>
			Set Border= XMLDoc.CreateElement("Border")
			Borders.AppendChild (Border)
			border.SetAttribute "ss:Position", "Left" 
			border.SetAttribute "ss:LineStyle", "Continuous" 
			border.SetAttribute "ss:Weight", "2" 
			border.SetAttribute "ss:Color", myWhite 
			'<Border ss:Position="Right" ss:LineStyle="Continuous" ss:Weight="2"	ss:Color="#FFFFFF"/>
			Set Border= XMLDoc.CreateElement("Border")
			Borders.AppendChild (Border)
			border.SetAttribute "ss:Position", "Right" 
			border.SetAttribute "ss:LineStyle", "Continuous" 
			border.SetAttribute "ss:Weight", "2" 
			border.SetAttribute "ss:Color", myWhite 
		'</Borders>
	   '    <Font x:Family="Swiss" ss:Color=myDarkerGrey/>
	    Set Font = XMLDoc.CreateElement("Font")
	    Style.AppendChild (Font)
		Font.SetAttribute "ss:FontName", "Tahoma"
	    Font.SetAttribute "ss:Color", myDarkerGrey
	    Font.SetAttribute "x:Family", "Swiss"
	   '    <Interior ss:Color=myLightGrey	  ss:Pattern="Solid"/>
	    Set Interior = XMLDoc.CreateElement("Interior")
	    Style.AppendChild (Interior)
	    Interior.SetAttribute "ss:Color", myLightGrey	 
	    Interior.SetAttribute "ss:Pattern", "Solid"
	  '    </Style>
	  '    <Style ss:ID="s23">
	    Set Style= XMLDoc.CreateElement("Style")
	    Styles.AppendChild (Style)
	    Style.SetAttribute "ss:ID", "s23"
	   '    <Font x:Family="Swiss" ss:Color=myLightGrey	  ss:Bold="1"/>
	    Set Font = XMLDoc.CreateElement("Font")
	    Style.AppendChild (Font)
	    Font.SetAttribute "ss:Color", myLightGrey	 
		Font.SetAttribute "ss:FontName", "Tahoma"
	    Font.SetAttribute "x:Family", "Swiss"
	    Font.SetAttribute "ss:Bold", "1"
	   '    <Interior ss:Color=myDarkerGrey ss:Pattern="Solid"/>
	    Set Interior = XMLDoc.CreateElement("Interior")
	    Style.AppendChild (Interior)
	    Interior.SetAttribute "ss:Color", myDarkerGrey
	    Interior.SetAttribute "ss:Pattern", "Solid"
	  '    </Style>
	  '    <Style ss:ID="s24">
	    Set Style= XMLDoc.CreateElement("Style")
	    Styles.AppendChild (Style)
	    Style.SetAttribute "ss:ID", "s24"
	   '    <Font x:Family="Swiss" ss:Size="12" ss:Color=myDarkerGrey ss:Bold="1"/>
	    Set Font = XMLDoc.CreateElement("Font")
	    Style.AppendChild (Font)
		Font.SetAttribute "ss:FontName", "Tahoma"
	    Font.SetAttribute "x:Family", "Swiss"
	    Font.SetAttribute "ss:Size", "12"
	    Font.SetAttribute "ss:Color", myDarkerGrey
	    Font.SetAttribute "ss:Bold", "1"
	  '    </Style>
	  '    <Style ss:ID="s25">
	    Set Style= XMLDoc.CreateElement("Style")
	    Styles.AppendChild (Style)
	    Style.SetAttribute "ss:ID", "s25"
	   '    <Font x:Family="Swiss" ss:Size="12" ss:Color=myDarkerGrey/>
	    Set Font = XMLDoc.CreateElement("Font")
	    Style.AppendChild (Font)
		Font.SetAttribute "ss:FontName", "Tahoma"
	    Font.SetAttribute "x:Family", "Swiss"
	    Font.SetAttribute "ss:Color", myDarkerGrey
	    Font.SetAttribute "ss:Size", "12"
	  '    </Style>
	  '    <Style ss:ID="s26">
	    Set Style= XMLDoc.CreateElement("Style")
	    Styles.AppendChild (Style)
	    Style.SetAttribute "ss:ID", "s26"
	   '    <Font x:Family="Swiss" ss:Color=myDarkerGrey ss:Bold="1"/>
	    Set Font = XMLDoc.CreateElement("Font")
	    Style.AppendChild (Font)
		Font.SetAttribute "ss:FontName", "Tahoma"
	    Font.SetAttribute "x:Family", "Swiss"
	    Font.SetAttribute "ss:Color", myDarkerGrey
	    Font.SetAttribute "ss:Bold", "1"
	   '    <Interior ss:Color=myLightGrey	 ss:Pattern="Solid"/>
	    Set Interior = XMLDoc.CreateElement("Interior")
	    Style.AppendChild (Interior)
	    Interior.SetAttribute "ss:Color", myLightGrey	
	    Interior.SetAttribute "ss:Pattern", "Solid"
	  '    </Style>
	 '    </Styles>
	' </Styles>
	 
 ' </Workbook>
	set XMLExcelFileInit = XMLDoc
end function

public function XMLExcelFileAddWorksheet(XMLFileObj,name)
	mydebug ("XMLExcelFileAddWorksheet ")
	if DDEEVV = True then on error goto 0 else on error resume next
	dim XMLDoc
	if  not Isobject(XMLFileObj) then
		mydebug ("XMLExcelFileAddWorksheet XMLFileObj not Isobject(XMLFileObj) ")
		exit function
	end if
	set XMLDoc = XMLFileObj
	Dim root
	Set Root = XMLDoc.documentElement 
	dim workbook
	Set Workbook = root
	'<Worksheet ss:Name="Tabelle1">
	dim Worksheet
	Set Worksheet = XMLDoc.CreateElement("Worksheet")
	Workbook.AppendChild(Worksheet)
	Worksheet.SetAttribute "ss:Name", DBGetTableName("") & "." & name
	' <Table>
	dim Table
	Set Table = XMLDoc.CreateElement("Table")
	Worksheet.AppendChild(Table)
	Table.SetAttribute "ss:DefaultColumnWidth", "160"
	
	Dim Column
	Set Column = XMLDoc.CreateElement("Column")
	Table.AppendChild(Column)
	Column.SetAttribute "ss:Width", "160"
	Column.SetAttribute "ss:Span", "1"
	
	dim WorksheetOptions
	Set WorksheetOptions = XMLDoc.CreateElement("WorksheetOptions")
	Worksheet.AppendChild(WorksheetOptions)
	WorksheetOptions.SetAttribute "xmlns", "urn:schemas-microsoft-com:office:excel"
	dim Zoom
	Set Zoom = XMLDoc.CreateElement("Zoom")
	WorksheetOptions.AppendChild(Zoom)
	Zoom.Text = "82"
	mydebug ("XMLExcelFileAddWorksheet before exit")	   
	set XMLExcelFileAddWorksheet = Table
end function

private XMLADDRowRows(10,2)

public function XMLExcelFILEAddRow(XMLWorksheet, style, rownumber)
	'mydebug ("XMLExcelFILEAddRow ")
	if DDEEVV = True then on error goto 0 else on error resume next
	dim table
	if not Isobject(XMLWorksheet) then
		mydebug ("XMLExcelFileAddWorksheet XMLWorksheet  not Isobject(XMLWorksheet) ")
		exit function
	end if
	'mydebug ("XMLExcelFILEAddRow 1")
	set table = XMLWorksheet
	'mydebug ("XMLExcelFILEAddRow 2")
	' <Row>
	dim Row
	Set Row = table.ownerDocument.CreateElement("Row")
	if style = XMLStyleNormal then
		if rownumber mod 2 = 0 then
			style = XMLStyleNormalEven
		else 
			style = XMLStyleNormalOdd
		end if 
	end if 
	Row.SetAttribute "ss:StyleID", style
	Table.AppendChild(Row)
	'mydebug ("XMLExcelFILEAddRow 99")
	set XMLExcelFILEAddRow = row
end function

public function XMLExcelFILEAddCell(XMLRow,cellValue,CellType)
	if DDEEVV = True then on error goto 0 else on error resume next
	if not Isobject(XMLRow) then
		mydebug ("XMLExcelFileAddWorksheet XMLRow not Isobject(XMLRow) ")
		exit function
	end if
	dim row
	set row = XMLRow
	' <Cell><Data ss:Type="String">col1</Data></Cell>
	Dim Cell 
	Set Cell = XMLRow.ownerDocument.CreateElement("Cell")
	Row.AppendChild(Cell)
'		Cell.SetAttribute "ss:StyleID", "s21"
	dim data
	Set Data = XMLRow.ownerDocument.CreateElement("Data")
	Data.Text = cellValue
	Cell.AppendChild(data)
	Data.SetAttribute "ss:Type", CellType
	set XMLExcelFILEAddCell = cell
end function

public function XMLExcelFILEClose (XMLFileObj, filename)
	myDebug("XMLExcelFILEClose " & filename	)
	if DDEEVV = True then on error goto 0 else on error resume next
	if not Isobject(XMLFileObj) then
		mydebug ("XMLExcelFileAddWorksheet XMLFileObj  not Isobject(XMLFileObj) ")
		exit function
	end if
	Dim strDirName
	FormatXmlDocument XMLFileObj
	strDirName=	Left(filename, InStrRev(filename,"\"))
	myDebug(strDirName & " create"	)
	makeDirectory (strDirName)
	myDebug(filename & " create"	)
	XMLFileObj.Save(filename)
	If Err <> 0 Then
				LogFileWrite (filename & ":: something wrong with ->" & Err.Number & " -- " &  Err.Description)
				myDebug(filename & ":: something wrong with ->" & Err.Number & " -- " &  Err.Description)
				Err.Clear
	Else
				logfilewrite(filename & " created")
				myDebug(filename & " created"	)
	End If
	myDebug("XMLExcelFILEClose done" & filename	)
end function

'----------------------------------------------------------------------------------------
' Helper function to format XML-Output
'----------------------------------------------------------------------------------------
' Add formatting to this element. Indent it and add a
' carriage return before its children. Then recursively
' format the children with increased indentation.

Private Sub FormatXmlDocument(ByVal xml_doc)
	if DDEEVV = True then on error goto 0 else on error resume next
    FormatXmlNode xml_doc.documentElement, 0
End Sub

Private Sub FormatXmlNode(ByVal node, ByVal   indent)
	if DDEEVV = True then on error goto 0 else on error resume next
    ' NodeType Named Constant
    dim myNodeType(13)
    myNodeType (0) = ""
    myNodeType (1) = "ELEMENT_NODE"
    myNodeType (2) = "ATTRIBUTE_NODE"
    myNodeType (3) = "TEXT_NODE"
    myNodeType (4) = "CDATA_SECTION_NODE"
    myNodeType (5) = "ENTITY_REFERENCE_NODE"
    myNodeType (6) = "ENTITY_NODE"
    myNodeType (7) = "PROCESSING_INSTRUCTION_NODE"
    myNodeType (8) = "COMMENT_NODE"
    myNodeType (9) = "DOCUMENT_NODE"
    myNodeType (10) = "DOCUMENT_TYPE_NODE"
    myNodeType (11) = "DOCUMENT_FRAGMENT_NODE"
    myNodeType (12) = "NOTATION_NODE"

    Dim child 'As IXMLDOMNode
    Dim text_only 'As Boolean
    
    dim mystring
    mystring = ""
	dim myi
		
    for myi = 0 to indent
         mystring = mystring & " "
    next

    ' Do nothing if this is a text node.
    'If TypeOf node Is IXMLDOMText Then Exit Sub
    If node.nodetype = 3 or node.nodename = "Data" Then Exit Sub

    ' See if this node contains only text.
	text_only = True
    If node.hasChildNodes Then
        For Each child In node.childNodes
            If Not (child.nodetype = 3) and not child.nodename = "Data" Then
                text_only = False
                Exit For
            End If
        Next 'child
    End If

    ' Process child nodes.
    If node.hasChildNodes Then
        ' Add a carriage return before the children.
        If Not text_only Then
            node.insertBefore node.ownerDocument.createTextNode(vbCrLf), node.firstChild
        End If

        ' Format the children.
        For Each child In node.childNodes
            FormatXmlNode child, indent + 2
        Next 'child
    End If

    ' Format this element.
    If indent > 0 Then
        ' Indent before this element.
        node.parentNode.insertBefore node.ownerDocument.createTextNode(mystring),  node

        ' Indent after the last child node.
        If Not text_only Then
            node.appendChild node.ownerDocument.createTextNode(mystring)
        end if

        ' Add a carriage return after this node.
        If node.nextSibling Is Nothing Then
            node.parentNode.appendChild node.ownerDocument.createTextNode(vbCrLf)
        Else
            node.parentNode.insertBefore node.ownerDocument.createTextNode(vbCrLf), node.nextSibling
        End If
    End If
End Sub

'************************************
' TIMEZONE
'************************************

Public Function TimeZone
	if DDEEVV = True then on error goto 0 else on error resume next
	Dim RegularExpressionObject
	Dim objWMIService
	Dim colItems, objItem
	on error resume next 
	Set RegularExpressionObject = New RegExp
	
	Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")
	Set colItems = objWMIService.ExecQuery("Select * from Win32_TimeZone")
	For Each objItem In colItems
		'   LogFileWrite( "Bias: " & objItem.Bias
		'   LogFileWrite( "Caption: " & objItem.Caption
		With RegularExpressionObject
			.Pattern = ".*\((.*)\).*"
			.IgnoreCase = True
			.Global = True
		End With
		TimeZone=RegularExpressionObject.Replace(objItem.Caption, "$1")
	Next
	If Err <> 0 Then
			LogFileWrite "mail not sent: " & Err.Number & " -- " &  Err.Description & " " & subject
			Err.Clear
			TimeZone = "TZ0"
	End If
	if DDEEVV = true then On Error Goto 0
End Function

Function UserNameGet()
	if DDEEVV = True then on error goto 0 else on error resume next
	Dim objNET
		Dim StrUserName
	Set objNET = WScript.CreateObject("WScript.Network")
	UserNameGet = objNET.UserName
End Function

Function ComputerNameGet()
	if DDEEVV = True then on error goto 0 else on error resume next
	Dim objNET
	Dim StrComputerName
	Set objNET = WScript.CreateObject("WScript.Network")
	ComputerNameGet = objNET.ComputerName
End Function

Public Function CRC32(Str )
  if DDEEVV = True then on error goto 0 else on error resume next
  Dim i 
  Dim j 
  Dim nPowers(8) 
  Dim nCRC 
  Dim nByte 
  Dim nBit 
  
  For i = 0 To 7
     nPowers(i) = 2 ^ i
  Next 'i
  For i = 1 To Len(Str)
    nByte = Asc(Mid(Str, i, 1))
    For j = 7 To 0 Step -1
      nBit = CBool((nCRC And 32768) = 32768) Xor _
       ((nByte And nPowers(j)) = nPowers(j))
      nCRC = (nCRC And 32767) * 2
      If nBit Then
        nCRC = nCRC Xor &H8005
      End If
    Next 'j
  Next 'i
  CRC32 = nCRC
End Function


'' SIG '' Begin signature block
'' SIG '' MIID6AYJKoZIhvcNAQcCoIID2TCCA9UCAQExDjAMBggq
'' SIG '' hkiG9w0CBQUAMGYGCisGAQQBgjcCAQSgWDBWMDIGCisG
'' SIG '' AQQBgjcCAR4wJAIBAQQQTvApFpkntU2P5azhDxfrqwIB
'' SIG '' AAIBAAIBAAIBAAIBADAgMAwGCCqGSIb3DQIFBQAEENO3
'' SIG '' juVxfBkZMul8+Zga0YWgggISMIICDjCCAXegAwIBAgIQ
'' SIG '' fduYp37PJolB2l4qUoy9tjANBgkqhkiG9w0BAQQFADAV
'' SIG '' MRMwEQYDVQQDEwplLW52ZW50b3J5MB4XDTEwMTIzMTIz
'' SIG '' MDAwMFoXDTE2MTIzMTIzMDAwMFowFTETMBEGA1UEAxMK
'' SIG '' ZS1udmVudG9yeTCBnzANBgkqhkiG9w0BAQEFAAOBjQAw
'' SIG '' gYkCgYEAxoqL8otb0bZl/B6QNeNKa7wgv9FzkgeuH0/K
'' SIG '' Mqta3uf+k/JJF0eRdm/e+R17t2Fy0nn4kkfK/0339ZKA
'' SIG '' j+LrC6N0Z2XzotG2Tf5CR2XYHwGWtXvL1edczqrPEwnJ
'' SIG '' Bep8Fki6p0/CSSFueWSjRmMr3nP5+PNnMWarU/OyVdep
'' SIG '' yDMCAwEAAaNfMF0wEwYDVR0lBAwwCgYIKwYBBQUHAwMw
'' SIG '' RgYDVR0BBD8wPYAQlJeutLm/XtOFAEGETQ1/HKEXMBUx
'' SIG '' EzARBgNVBAMTCmUtbnZlbnRvcnmCEH3bmKd+zyaJQdpe
'' SIG '' KlKMvbYwDQYJKoZIhvcNAQEEBQADgYEAKFw68m9BqK1a
'' SIG '' mJUm2YxwCsT3mWy4nilgTWlC+wj64jouYVSY1Ozhm7L8
'' SIG '' ALBzVvvFCeHMHmvpN4pZdqzAf9CnTcNWPkYBq5Hep2aM
'' SIG '' by6t/JiG9lPhC327WWW5IQV3T+FtK2G1qW9UMGi83PMV
'' SIG '' FhUJeBp5hhxXhWORlcBZg5aiVpgxggFAMIIBPAIBATAp
'' SIG '' MBUxEzARBgNVBAMTCmUtbnZlbnRvcnkCEH3bmKd+zyaJ
'' SIG '' QdpeKlKMvbYwDAYIKoZIhvcNAgUFAKBsMBAGCisGAQQB
'' SIG '' gjcCAQwxAjAAMBkGCSqGSIb3DQEJAzEMBgorBgEEAYI3
'' SIG '' AgEEMBwGCisGAQQBgjcCAQsxDjAMBgorBgEEAYI3AgEV
'' SIG '' MB8GCSqGSIb3DQEJBDESBBBlyV361t/uWuwFv2GqqGFR
'' SIG '' MA0GCSqGSIb3DQEBAQUABIGAspy75e1Hg5O3762KZfG8
'' SIG '' 61y79oxZHqRWGq25lDsiP2o/nCwptCqSowAWjSKyGrRj
'' SIG '' gin139771vR7L1K/4/dKCY0/TRWSscZI510sHL5ba0yR
'' SIG '' pLp3mBnXuVB0gCx9bbSj2dII1AX4KuJdDnGM2dSSeUBp
'' SIG '' ZH3Jx8dq7rIrXVk4gCs=
'' SIG '' End signature block
